home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H108.ZIP / JUL91.ZIP / TIP612X.LSP < prev    next >
Lisp/Scheme  |  1991-08-27  |  2KB  |  52 lines
  1. ;TIP612X.LSP   No-Conflict Text   (c)1991, Jim Regier
  2.  
  3. (defun C:SHADOW2 (/ SET TXT CLAY NUM ITEM
  4.      EN ED E1 PT1 PT2 PT3 PT4 OFFSET ANG1
  5.      ANG2 LEN LEN1)
  6.   (setvar "CMDECHO" 0)
  7.   (princ "\nPick Text to Shadow")
  8.   (setq TXT (ssget)
  9.         NUM (sslength TXT)
  10.         ITEM 0
  11.   )
  12.   (command "ELEV" "0.01" "")
  13.   (while (< ITEM NUM)
  14.     (setq EN (ssname TXT ITEM))
  15.     (setq ED (entget EN))
  16.     (if (= (cdr (assoc 0 ED)) "TEXT")
  17.       (progn
  18.         (setq OFFSET (/(cdr(assoc 40 ED))
  19.           5.0))
  20.         ;distance from box to text based
  21.         ;on text height / 5
  22.         (setq E1 ED) ;save original
  23.         (setq ED (subst (cons 72 2)
  24.           (assoc 72 ED) ED))
  25.         (entmod ED)
  26.         (setq ED (entget EN))
  27.         (setq PT1 (cdr (assoc 10 ED)))
  28.         (setq PT2 (cdr (assoc 11 ED)))
  29.         (setq LEN (distance PT1 PT2))
  30.         (setq ED E1)
  31.         (entmod ED)
  32.         (setq PT1 (cdr (assoc 10 ED)))
  33.         (setq ANG1 (cdr (assoc 50 ED)))
  34.         (setq ANG2 (+ ANG1 (/ pi 2)))
  35.         (setq PT1 (polar PT1 (+ ANG1 pi)
  36.           OFFSET))
  37.         (setq PT1 (polar PT1 (+ ANG2 pi)
  38.           OFFSET))
  39.         (setq PT2 (polar PT1 ANG1
  40.           (+ LEN (* 2 OFFSET))))
  41.         (setq LEN1 (+ (cdr (assoc
  42.           40 ED)) (* 2 OFFSET)))
  43.         (setq PT3 (polar PT2 ANG2 LEN1))
  44.         (setq PT4 (polar PT1 ANG2 LEN1))
  45.         (command "3DFACE" PT1 PT2 PT3
  46.           PT4 "")
  47.       ) ;end progn
  48.     ) ;end if
  49.     (setq ITEM (1+ ITEM))
  50.   )(princ) ;end while
  51. )
  52.